home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
tcl
/
tcl70b2.lha
/
tcl7.0b2
/
tclMain.c
< prev
next >
Wrap
C/C++ Source or Header
|
1993-06-17
|
6KB
|
208 lines
/*
* main.c --
*
* Main program for Tcl shells and other Tcl-based applications.
*
* Copyright (c) 1988-1993 The Regents of the University of California.
* All rights reserved.
*
* Permission is hereby granted, without written agreement and without
* license or royalty fees, to use, copy, modify, and distribute this
* software and its documentation for any purpose, provided that the
* above copyright notice and the following two paragraphs appear in
* all copies of this software.
*
* IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
* DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
* OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
* CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
* THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
* INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
* AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
* ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
* PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
*/
#ifndef lint
static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclMain.c,v 1.2 93/06/17 16:13:53 ouster Exp $ SPRITE (Berkeley)";
#endif
#include "tclInt.h"
#include "tclUnix.h"
static Tcl_Interp *interp; /* Interpreter for application. */
static Tcl_DString command; /* Used to buffer incomplete commands being
* read from stdin. */
#ifdef TCL_MEM_DEBUG
static char dumpFile[100]; /* Records where to dump memory allocation
* information. */
static int quitFlag = 0; /* 1 means the "checkmem" command was
* invoked, so the application should quit
* and dump memory allocation information. */
#endif
/*
* Forward references for procedures defined later in this file:
*/
static int CheckmemCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char *argv[]));
/*
*----------------------------------------------------------------------
*
* main --
*
* This is the main program for a Tcl-based shell that reads
* Tcl commands from standard input.
*
* Results:
* None.
*
* Side effects:
* Can be almost arbitrary, depending on what the Tcl commands do.
*
*----------------------------------------------------------------------
*/
int
main(argc, argv)
int argc; /* Number of arguments. */
char **argv; /* Array of argument strings. */
{
char buffer[1000], *cmd, *args, *fileName;
int result, gotPartial, tty;
interp = Tcl_CreateInterp();
#ifdef TCL_MEM_DEBUG
Tcl_InitMemory(interp);
Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
#endif
/*
* Make command-line arguments available in the Tcl variables "argc"
* and "argv". If the first argument doesn't start with a "-" then
* strip it off and use it as the name of a script file to process.
*/
fileName = NULL;
if ((argc > 1) && (argv[1][0] != '-')) {
fileName = argv[1];
argc--;
argv++;
}
args = Tcl_Merge(argc-1, argv+1);
Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
ckfree(args);
sprintf(buffer, "%d", argc-1);
Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
*/
if (Tcl_AppInit(interp) != TCL_OK) {
fprintf(stderr, "%s\n", interp->result);
exit(1);
}
/*
* If a script file was specified then just source that file
* and quit.
*/
if (fileName != NULL) {
result = Tcl_EvalFile(interp, fileName);
if (result != TCL_OK) {
fprintf(stderr, "%s\n", interp->result);
exit(1);
}
exit(0);
}
/*
* Process commands from stdin until there's an end-of-file.
*/
gotPartial = 0;
tty = isatty(0);
Tcl_DStringInit(&command);
while (1) {
clearerr(stdin);
if (!gotPartial && tty) {
fputs("% ", stdout);
fflush(stdout);
}
if (fgets(buffer, 1000, stdin) == NULL) {
if (!gotPartial) {
exit(0);
}
buffer[0] = 0;
}
cmd = Tcl_DStringAppend(&command, buffer, -1);
if ((buffer[0] != 0) && !Tcl_CommandComplete(cmd)) {
gotPartial = 1;
continue;
}
gotPartial = 0;
result = Tcl_RecordAndEval(interp, cmd, 0);
Tcl_DStringFree(&command);
if (result != TCL_OK) {
fprintf(stderr, "%s\n", interp->result);
} else if (tty && (*interp->result != 0)) {
printf("%s\n", interp->result);
}
#ifdef TCL_MEM_DEBUG
if (quitFlag) {
Tcl_DeleteInterp(interp);
Tcl_DumpActiveMemory(dumpFile);
exit(0);
}
#endif
}
}
/*
*----------------------------------------------------------------------
*
* CheckmemCmd --
*
* This is the command procedure for the "checkmem" command, which
* causes the application to exit after printing information about
* memory usage to the file passed to this command as its first
* argument.
*
* Results:
* Returns a standard Tcl completion code.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#ifdef TCL_MEM_DEBUG
/* ARGSUSED */
static int
CheckmemCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Interpreter for evaluation. */
int argc; /* Number of arguments. */
char *argv[]; /* String values of arguments. */
{
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" fileName\"", (char *) NULL);
return TCL_ERROR;
}
strcpy(dumpFile, argv[1]);
quitFlag = 1;
return TCL_OK;
}
#endif